home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 July / EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso / earkit / news / thor / rexx / local2email.br < prev    next >
Text File  |  1998-05-24  |  9KB  |  328 lines
  1. /*
  2. ** $VER: Local2Email.br 1.56 (8.9.97)
  3. ** by Eirik Nicolai Synnes
  4. **
  5. ** Based on ML2Email.thor by Remco van Hooff
  6. **
  7. ** See SortMail.guide for documentation
  8. **
  9. */
  10.  
  11. options results
  12.  
  13. parse arg arguments
  14.  
  15. /*
  16. ** Initialize some variables
  17. */
  18.  
  19. template = 'SYSTEM/A'
  20.  
  21. fromthor = 0; cfgread = 0
  22.  
  23. EVE_ENTERMSG       =  0  /* Enter message */
  24. EVE_REPLYMSG       =  1  /* Reply message */
  25. EVE_FORWARDMSG     =  9  /* Forward message (only for TCP/SOUP) */
  26.  
  27. EDB_DELETED        =  0  /* Event is deleted */
  28. EDB_PACKED         =  1  /* Event is packed */
  29. EDB_DONE           =  2  /* Event is done */
  30. EDB_ERROR          =  3  /* Error performing this event */
  31. EDB_UNRECOVERABLE  =  4  /* Event can not be undeleted */
  32. EDB_FREEZE         =  5  /* Event is frozen. Will not be done as long as this flag is set. */
  33.  
  34. CDB_MAIL           =  1  /* Private mail conference. */
  35. CDB_NOT_ON_BBS     = 15  /* This conference is not on the bbs. */
  36.  
  37. CDNT_MAILFOLDER    =  3  /* This conference is a mail folder. */
  38.  
  39. UDB_DELETED        =  0  /* User is deleted */
  40. UDB_UNRECOVERABLE  =  1  /* User can not be undeleted */
  41.  
  42. BDB_EVENTS_CHANGED =  5  /* Events changed after last event package was made. */
  43.  
  44. /*
  45. ** Find/open Thor ARexx port
  46. */
  47.  
  48. /* See if I'm run from Thor */
  49.  
  50. if left(address(), 5) = 'THOR.' then do
  51.     thorport = address()
  52.     address(thorport)
  53.     'CURRENTSYSTEM STEM 'cursys
  54.     if rc ~= 0 then do
  55.         say 'CURRENTSYSTEM: 'THOR.LASTERROR
  56.         exit(rc)
  57.         end
  58.     else fromthor = 1
  59.     end
  60.  
  61. /*
  62. ** Find/open BBSREAD ARexx port
  63. */
  64.  
  65. if ~show('P', 'BBSREAD') then do
  66.     address(command)
  67.     'Run >NIL: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  68.     if exists('SYS:RexxC/WaitForPort') then 'SYS:RexxC/WaitForPort BBSREAD'
  69.     else 'WaitForPort BBSREAD'
  70.     if (rc = 5) then do; myerr = 'Couldn''t open BBSREAD''s ARexx port.'; rc = 30; signal error; end
  71.     if (rc ~= 0) then do; myerr = 'Could not find SYS:Rexxc/WaitForPort.'; rc = 30; signal error; end
  72.     end
  73.  
  74. /*
  75. ** Parse arguments
  76. */
  77.  
  78. address(bbsread)
  79.  
  80. if ~fromthor then do
  81.     if arguments = '?' | arguments = '' then do
  82.         say 'Usage: 'template
  83.         exit(0)
  84.         end
  85.     'READARGS 'template args' CMDLINE 'arguments
  86.     if rc ~= 0 then do
  87.         say 'READARGS: 'BBSREAD.LASTERROR
  88.         exit(rc)
  89.         end
  90.     cursys.BBSNAME = args.SYSTEM
  91.     end
  92.  
  93. /*
  94. ** Get system info
  95. */
  96.  
  97.  
  98. 'GETBBSDATA BBSNAME "'cursys.BBSNAME'" STEM 'bbsdata
  99. if rc ~= 0 then do
  100.     say 'GETBBSDATA: 'BBSREAD.LASTERROR
  101.     exit(rc)
  102.     end
  103. if (right(bbsdata.BBSPATH, 1) ~= ':') & (right(bbsdata.BBSPATH, 1) ~= '/') then bbsdata.BBSPATH = bbsdata.BBSPATH || '/'
  104.  
  105. /*
  106. ** Leave if there are no active changed events
  107. */
  108.  
  109. if (bbsdata.NUMEVENTS = 0) | ~bittst(bbsdata.FLAGS, BDB_EVENTS_CHANGED) then exit(0)
  110.  
  111. /*
  112. ** Find name of email conference
  113. */
  114.  
  115. 'GETCONFLIST BBSNAME "'cursys.BBSNAME'" STEM 'conflist
  116. if rc ~= 0 then do
  117.     say 'GETCONFLIST: 'BBSREAD.LASTERROR
  118.     exit(rc)
  119.     end
  120.  
  121. mailcount = 0
  122. do i = 1 to conflist.COUNT
  123.     'GETCONFDATA "'cursys.BBSNAME'" "'conflist.i'" 'confdata
  124.     if rc ~= 0 then do
  125.         say 'GETCONFDATA: 'BBSREAD.LASTERROR
  126.         exit(rc)
  127.         end
  128.     if bittst(confdata.FLAGS, CDB_MAIL) then do
  129.         email = confdata.NAME; mailcount = mailcount + 1
  130.         end
  131.     end
  132.  
  133. if symbol('email') ~= 'VAR' then do
  134.     say 'Couldn''t find Email conference'
  135.     exit(20)
  136.     end
  137.  
  138. if mailcount > 1 then email = readcfg(1)
  139.  
  140. /*
  141. ** Main loop
  142. */
  143.  
  144. do n = bbsdata.FIRSTEVENT to bbsdata.LASTEVENT
  145.     drop eventtags. eventdata.
  146.  
  147.     changed = 0; crosspost = 0
  148.  
  149.     /* Read event data */
  150.  
  151.     'READBREVENT "'cursys.BBSNAME'" EVENTNR 'n' DATASTEM 'eventdata' TAGSSTEM 'eventtags
  152.     if rc ~= 0 then do
  153.         say 'READBREVENT: 'BBSREAD.LASTERROR
  154.         exit(rc)
  155.         end
  156.  
  157.     /* Skip event if it is not a reply/enter or it is deleted, packed, etc. */
  158.  
  159.     if ~(eventdata.EVENTTYPE = EVE_ENTERMSG | eventdata.EVENTTYPE = EVE_REPLYMSG | eventdata.EVENTTYPE = EVE_FORWARDMSG) then iterate n
  160.     if bittst(eventdata.FLAGS, EDB_DELETED) | bittst(eventdata.FLAGS, EDB_PACKED) | bittst(eventdata.FLAGS, EDB_DONE) | bittst(eventdata.FLAGS, EDB_ERROR) | bittst(eventdata.FLAGS, EDB_UNRECOVERABLE) | bittst(eventdata.FLAGS, EDB_FREEZE) then iterate n
  161.  
  162.     /* Split conferences and to-addresses into stems */
  163.  
  164.     if index(eventtags.CONFERENCE, ',') > 0 then do
  165.         crosspost = 1; confs = eventtags.CONFERENCE; ccnt = 0
  166.         do while index(confs, ',') > 0
  167.             ccnt = ccnt + 1; confs.ccnt = left(confs, (index(confs, ',') - 1))
  168.             confs = substr(confs, index(confs, ',') + 1)
  169.             end
  170.         ccnt = ccnt + 1; confs.ccnt = confs; confs.count = ccnt; drop confs ccnt
  171.         end
  172.     else do; confs.count = 1; confs.1 = eventtags.CONFERENCE; end
  173.  
  174.     if index(eventtags.TOADDR, ',') > 0 then do
  175.         toaddrs = eventtags.TOADDR; acnt = 0
  176.         do while index(toaddrs, ',') > 0
  177.             acnt = acnt + 1; toaddrs.acnt = left(toaddrs, (index(toaddrs, ',') - 1))
  178.             toaddrs = substr(toaddrs, index(toaddrs, ',') + 1)
  179.             end
  180.         acnt = acnt + 1; toaddrs.acnt = toaddrs; toaddrs.count = acnt; drop toaddrs acnt
  181.         end
  182.     else do; toaddrs.count = 1; toaddrs.1 = eventtags.TOADDR; end
  183.  
  184.     /* Replace local conferences with email conference and add reply address */
  185.  
  186.     do i = 1 to confs.count
  187.         drop confdata.; unknown = 0
  188.         'GETCONFDATA "'cursys.BBSNAME'" "'confs.i'" 'confdata
  189.         if rc ~= 0 then do
  190.             if BBSREAD.LASTERROR = 'Unknown conference' then unknown = 1
  191.             else do
  192.                 say 'GETCONFDATA: 'BBSREAD.LASTERROR
  193.                 exit(rc)
  194.                 end
  195.             end
  196.  
  197.         if ~(unknown) & (confdata.CONFNETTYPE = CDNT_MAILFOLDER) then do
  198.             if cfgread = 0 then call readcfg(0); addradd = 0
  199.  
  200.             if trig.count > 0 then do m = 1 to trig.count
  201.                 if upper(trig.m.conf) = upper(confs.i) then do
  202.                     match = 0
  203.                     do j = 1 to toaddrs.count
  204.                         if upper(toaddrs.j) = upper(trig.m.addr) then match = 1
  205.                         end
  206.                     if ~match then do
  207.                         acnt = toaddrs.count + 1; toaddrs.acnt = trig.m.addr; toaddrs.count = acnt; addradd = 1
  208.                         end
  209.                     end
  210.                 end
  211.  
  212.             if (addradd | confs.i ~= email) then confs.i = email
  213.             changed = 1
  214.             end
  215.         end
  216.  
  217.     /* Recreate conference and to-address strings */
  218.  
  219.     eventtags.CONFERENCE = ''; mailfound = 0
  220.     do i = 1 to confs.count
  221.         if (upper(confs.i) ~= upper(email)) | (~mailfound) then eventtags.CONFERENCE = eventtags.CONFERENCE || confs.i || ','
  222.         if (~mailfound) & (upper(confs.i) = upper(email)) then mailfound = 1
  223.         end
  224.     eventtags.CONFERENCE = strip(eventtags.CONFERENCE, 'B', ',')
  225.  
  226.     eventtags.TOADDR = ''
  227.     do i = 1 to toaddrs.count
  228.         eventtags.TOADDR = eventtags.TOADDR || toaddrs.i || ','
  229.         end
  230.     eventtags.TOADDR = strip(eventtags.TOADDR, 'B', ',')
  231.  
  232.     /* Replace names with corresponding address(es) */
  233.  
  234.     if (~crosspost) & (symbol('eventtags.TOADDR') = 'VAR') & (strip(eventtags.TOADDR, 'B') ~= '') & (length(eventtags.TOADDR) = length(compress(eventtags.TOADDR, '@#?*()|'))) then do
  235.         drop user.
  236.         'SEARCHBRUSER "'cursys.BBSNAME'" STEM 'user' SEARCH "'addasterix(eventtags.TOADDR)'" NAME'
  237.         if rc ~= 0 then do
  238.             say 'SEARCHBRUSER: 'BBSREAD.LASTERROR
  239.             exit(rc)
  240.             end
  241.         if result > 0 then do
  242.             drop usertags. userdata.
  243.             'READBRUSER BBSNAME "'cursys.BBSNAME'" USERNR 'user.1.USERNR' TAGSSTEM 'usertags' DATASTEM 'userdata
  244.             if rc ~= 0 then do
  245.                 say 'READBRUSER: 'BBSREAD.LASTERROR
  246.                 exit(rc)
  247.                 end
  248.             if ~bittst(userdata.FLAGS, UDB_DELETED) & ~bittst(userdata.FLAGS, UDB_UNRECOVERABLE) then do
  249.                 eventtags.TOADDR = usertags.ADDRESS; changed = 1
  250.                 end
  251.             end
  252.         end
  253.  
  254.     if changed then do
  255.         'WRITEBREVENT BBSNAME "'cursys.BBSNAME'" EVENT 'eventdata.EVENTTYPE' STEM 'eventtags 'UPDATEEVENTNR 'n
  256.         if rc ~= 0 then do
  257.             say 'READBRUSER: 'BBSREAD.LASTERROR
  258.             exit(rc)
  259.             end
  260.         end
  261.     end
  262.  
  263. exit(0)
  264.  
  265. /*
  266. ** Procedures
  267. */
  268.  
  269. readcfg: procedure expose cfgread trig. bbsdata.
  270.          parse arg email
  271.  
  272. foundcfg = 0; trigcnt = 0
  273.  
  274. cfgpath = bbsdata.BBSPATH
  275. cfgfile = 'SortMail.cfg'
  276.  
  277. if (right(cfgpath, 1) ~= '/') & (right(cfgpath, 1) ~= ':') then cfgpath = cfgpath || '/'
  278.  
  279. if ~exists(cfgpath || cfgfile) then do
  280.     say 'Couldn''t find SortMail.cfg'
  281.     exit(30)
  282.     end
  283.  
  284. cfgopen = open(cf, cfgpath || cfgfile, 'R')
  285.  
  286. address(bbsread)
  287.  
  288. if cfgopen then do until eof(cf)
  289.     entry = readln(cf)
  290.     if ~email & upper(subword(entry, 1, 1)) = 'ACTION' then do
  291.         'READARGS TEMPLATE "TYPE/A,DESTSYS/K,DESTCONF/K,REPLYADDR/K,SCRIPTNAME/K,SCRIPTOPTS/K,FILENAME/K,DIRECTORY/K,SUBSTITUTE/K,WITH/K,HEADER/S,APPEND/S,NOBIN/S,CHECKDUPES/S,DONTADD/S,NOSTATS/S,SUBJECT/K,SENDTO/K,TEXTFILE/K" STEM 'trigentry' CMDLINE 'subword(entry, 2)
  292.         if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
  293.         if (upper(trigentry.TYPE) = 'COPY' | upper(trigentry.TYPE) = 'SPLITDIGEST') & symbol('trigentry.REPLYADDR') = 'VAR' then do
  294.             trigcnt = trigcnt + 1; trig.trigcnt.conf = trigentry.DESTCONF; trig.trigcnt.addr = trigentry.REPLYADDR
  295.             end
  296.         trig.count = trigcnt; drop trigentry.
  297.         end
  298.     if email & upper(subword(entry, 1, 1)) = 'GLOBAL' then do
  299.         'READARGS TEMPLATE "SYSTEM/K,CONFERENCE/A,STATISTICS/S,NOWARN/S,LOGINSTATE/S" STEM 'trigentry' CMDLINE 'subword(entry, 2)
  300.         if rc ~= 0 then do; say 'READARGS: 'BBSREAD.LASTERROR; exit(rc); end
  301.         call close(cf)
  302.         return(trigentry.CONFERENCE)
  303.         end
  304.     end
  305.  
  306. cfgread = 1
  307.  
  308. call close(cf)
  309.  
  310. return(0)
  311.  
  312.  
  313. addasterix: interpret 'procedure expose 'globals
  314.             parse arg str
  315.  
  316. if str = '' then return(str)
  317.  
  318. lastfound = 0; found = index(str, '"')
  319. do while found > lastfound
  320.     secondpart = substr(str, found + length('"'))
  321.     firstpart = substr(str, 1, length(str) - length(substr(str, found)))
  322.     str = firstpart || '*"' || secondpart
  323.     lastfound = found + length('*"')
  324.     found = index(str, '"', lastfound)
  325.     end
  326.  
  327. return(str)
  328.